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® 
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i CORPORATION. . 

® 
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' FACILITY: FORTRAN compatibility Library 
i ABSTRACT: 
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FORTRAN compatibility error set and test and condition handler. 
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i] 
! 
' 
' 
! 
0036 : FORSSCOM_HANDLE performs default error handlin 
0037 ! which creates an environment compatible with the PDP-11 
003 ' FORTRAN IV-PLUS error environment. 
0039 ! This environment is only created if the user has a: 
Bee ; CALL ERRTST or CALL ERRSET in his program. 
aoe ENVIRONMENT: User Mode - AST re-entrant 
Boe AUTHOR: Thomas N. Hastings, CREATION DATE: 14-Dec-1977 
0046 ! MODIFIED BY: 
0047 ' 
0048 : Thomas N. Hastings, 14-Dec-1977: VERSION 0 
0049 : Poreviove. edit history removed. SBL 11-Nov-1980) 
005) ! 1-135 = Change file name to CONSETST. B32, and ¢_change the names of 
0051 1: the REQUIRE files similarly. JBS 1 
OO 2g ! 1-014 - Y date the coor igs ht notice. yas 16-N0 OvV-78 
005 ! 1-015 = Change the RE athe #e .% [ros FOR... to OTS... JBS 07-DEC-78 
Boe ! “318 - Add error numbers 49- ‘se 1979 
055 ! 1-017 = Rename errors i; 50. SB ? g Moms 
B038 ! 1-318 - Change error 95 to allow continuation. SBL 25-May-1979 
05 ! 1-019 - Correct a typo in the PSECT declaration that was not caught by 
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earlier BLISS compilers. Also, remove unnecessary REQUIRE 
files and put through PRETTY. JBS 06-SEP-1197 


nn 


60 0060 1-020 = Change MTHSK_SINCOSSIG to MTHEK_SIGLOSMAT. JBS 19-SEP-1979 
61 0061 1-021 = Add andl ing : of floating faults. Update names of error 
62 Boog codes to match latest list. SBL gener ter? 
63 00 1-088 - Add errors 17-19. SBL 11-Nov-1980 
1-023 = Don't change. severity of non-FORTRAN errors. SPR 11=-46349 


SBL 16-June-1982 
1-024 = Add call to FORSSINIT_ERRSET to notify shared RTL that it should 
record errors in our fables. SBL 29-Jun-198 
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compatibility error set and test 


SWITCHES: 


SWITCHES ADDRESSING_MODE (EXTERNAL = GENERAL, NONEXTERNAL = WORD_RELATIVE); 


TABLE OF CONTENTS: 


FORWARD ROUTINE 
COM_START 


COM” HANDLE 
RECORD_ER 


INCLUDE FILES: 


LIBRARY ‘RTLSTARLE'; 
*RTLIN: COMEST'; 
*RTLML:FORERR'; 
*"RILIN:RTLPSECT'; 
"RTLML :MTHERR'; 


REQUIRE 
REQUIRE 
REQUIRE 
REQUIRE 


LITERAL 


_SEVE . 
K-ERROR_LIMIT = 15; 


PSECT 


PLIT = LIBSINITIALIZE ( READ, NOWRITE, NOEXECUTE, NOSHARE, NOPIC, CONCATENATE, GLOBAL, ALIGN (2), 
ADDRESSING_MODE (GENERAL)); 


'¢ 


! Make LIBSINITIA 


! COM_ST 


' Don*t use LIB$I 


Compatibility startup routine 
FORTRAN compatibility error handler 
Record an error number 


R 
ROR: NOVALUE; 


STARLET Library for macros and symbols 
Common ERRTST, ERRSET macros 

FORTRAN error numbers 

Define DECLARE_PSECTS macro 


Math Library error numbers 


MACROS: 


EQUATED SYMBOLS: 


size of condition value severity field 
initial image error count Limit 


OWN STORAGE: 


PSECT DECLARATIONS: 
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ECT contribution so LIBINITIALIZE will call 
default handler and co-routine back. 
CT, since that for Common Run-time Library standard features. 
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1-024 14-Sep-1984 12:31:34 FORRTL.SRCJCOMSETST.B32;1 (2) 
; 12 0 if 1 !- 
: 130 75 (1 
s 131 74 1 BIND 
sy ; 75 (1 VECT = UPLIT (COM_STARTUP); 
“ae 0 6 1 
; 134 0377 1 !+ : 
: : 2 8 8 ! : Now declare usual PSECTs | : 
; 137 0380 1 DECLARE_PSECTS (F4PCOMPAT); ! declare PSECTs for F4PCOMPATS$ facility 
3 138 0381 1 ! Keep separate from sharable Library | 
; i O356 1 
; 140 O35 1 GLOBAL 
: 123 Bee : COMSSERRORCOUNT : INITIAL (K_ERROR_LIMIT) VOLATILE; ! Image error count Limit. 
3 128 0386 1 ! Decremented by COM_HANDLER. 
> 144 0387 1 ! EXIT on continuable error if 0. 
; «145 0388 1 !+ 
: 146 0389 1! Define FORTRAN compatibility error byte table 
; 1ee to44 : One byte per FORTRAN error number. 
3 133 Bae : Define macro to generate byte data for initializing OWN COMS$SERR_TAB. 
3; 151 0394 1 
: 152 0395 1 MACRO | 
3 135 0396 1 A (OCCURRED, ! error occurred since last CALL ERRTST 
3 «6154 0397 1 EREQ_ALLOW, ' ERR= allowed 
3; 395 0398 1 CONT_ALLOW, ! continue allowed 
; 156 0399 1 LOG ! print error message ; 
s Vor 0400 1 CONT_TYPE, ! 1 = take ERR= if present, else EXIT; 0 = continue | 
; 158 0401 1 COUNT, ! count against image Limit 
s 159 Beng 1 CONTINUE ! 1 = continuable (or ERR=), 0 = EXIT | 
; 160 m 0403 1 )= 
: 161 M0404 1 (OCCURRED*7 + EREQ_ALLOW*6 + CONT_ALLOW*S + 
3 166 0405 1 LOG*3 + CONT_TYPE*2 + COUNT*1 + CONTINUE) 2%; 
; 16 0406 1 
; 6164 0407 1 !4 
3; 6165 0408 1 ! Statically allocate a byte table, one byte fcr each FORTRAN error number 
: 166 0409 1 ! Each byte contains the error control status Tits. | 
3 «167 0410 1 !- ; 
: 168 0411 #1 
; 169 Reig 1 GLOBAL 
3 100 Retz : COM$$ERR_TAB : ALOCKVECTOR CFORSK_MAX_ERR + 1, 1, BYTE) INITIAL (BYTE (¢ 
: 76 0415 1 '¢ 
. ir 0415 1 Bigtita &- 
3 «174 0417 1 'crodOogOadOdoO 
s 175 0418 1 'CENGNUN 
: 176 0419 1 'uatTt TNT 
Bales 0420 1 'R T 1 
: 178 Bes) 1 ‘RAK T NW 
3; «179 04 ¢ 1 Zaft ae oe 
; 180 04 1 rete .F ice 
; «181 6 4 1 . 28 < 
3 136 425 1 ' WwW 
; % 04 § 1 !e 
: (184 be 1 
: «185 428 1 0, :@ 
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1-024 . . eee on 1 8ke 3:51i8, — ERbanre SAE cOmse t897093,1 9 02) 
: ‘? sf ! Me eV aletelslds ' VFEVALERR, 68 ! VARIABLE FORMAT EXPRESSION VALUE ERROR 
: 245 488 1 0, ! skip 69 
; 246 css 1 sath 
> 248 491 1 A(0,0,1,1,0,1,1), i INTZEROIV, 71 ! INTEGER ZERO DIVIDE 
: 249 492 1 A(0,0,1,1,0,1,1), 1 fF p i ! FLOATING OVERFLOW 
; 250 04935 1 A(0,0,1,1,0,1,1), ' FLOZERDIV, 7 ' FLOATING ZERO DIVIDE 
; 23 Bees ' A(0,0,1,1,0,1.,1), ! FLOUND, 74 ! FLOATING UNDERFLOW 
; 338 O49 0, ! skip 75 | 
: See 0496 1 A(0,0,1,1,0,1.1), ' DECSTROVE, 76 ! DECIMAL STRING OVERFLOW 
; $28 rh 44 | A(0,0,1,1,0,1,1), ! ARRREFOUT, 77 ! ARRAY REFERENCE OUTSIDE ARRAY 
: 258 0501 1 0.0, ! skip 78, 79 | 
; oo B208 1 
; 260 0503 1 A(0,0,0,1,0,1,1), ! WRONUMARG, 80 ! wrong number of arguments 
; 261 0504 1 A(0,0,0,1,0,1.1), ! INVARGMTH, 3] ! invalid argument to math Library 
: 506 0505 1 A(0,0,1,1,0,1,1), ' UNDEXP, ; ! undefined exponentiation 
; & 0506 (1 MRD el ed eBeded} ' LOGZERNEG, 8 ' logarithm of zero or negative value 
: see t44 ! A(0,0,1,1,0,1,1), ! SQUROONEG, 84 ! square root of negative value 
; 366 0509 1 0, 0, ! Skip 85 and 86 (used on PDP-11), | 
3 
; 268 0511 «1 A(0,0,1,1,0.,1.,1), ! SIGLOSMAT, 87 ! significance lost in math Library 
: 269 B2i¢ 1 A(0,0,1,1,0,1.1). ! FLOOVEMAT, 88 ! floating overflow in math Library 
: si Belz : A(0,0,1,1,0,1,1), ! FLOUNDMAT, 89 ! floating underflow in math Library 
: 372 0515 1 REP 93-89-1 OF BYTE (0), ! skip 90-92 | 
: @s 0516 i 
3: 274 0517 +1 
: $03 B216 i A (0, 0, 1, 1, 0, 1, 1))); ! ADJARRDIM, 93 ! ADJUSTABLE ARRAY DIMENSION ERROR 
3 57 0520 1! | 
s ee 0521 1 ! EXTERNAL REFERENCES: 
s ery 0522 1! 
; 280 0523 «1 
: 281 0524 1 EXTERNAL ROUTINE 
: 282 0525 1 FORSSERRSNS_SAV : NOVALUE, ' Save FORTRAN error info for ERRSNS 
; 283 0526 1 ! No logical unit associated with it. 
; 284 0527 1 FORSSINIT_ERRSET: NOVALUE, ' Pass recording routine addr 
: 285 0528 1 LIBSFIXUP FLT, ' Fixup reserved floating operands 
5 $89 0368 1 LIBS$SIM_TRAP ' Simulate floating traps 
; oBn bees : LIBSINITIALIZE; ' Cause LIBSINITIALIZE to be 
: 289 b2a6 1 ! Linked in so called before main program 
: 290 0533 1 ' causes COMSS$STARTUP to be called 
: 291 0534 1 ' before main program. 


M 2 | 
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. 12-808- 132 TEED FORRTL.SRC Conse tS + 63551 . (3) 
ROUTINE COM_STARTUP ( ! Initialize FORTRAN compatibility ERRTST, ERRSET support 
CO_ROUT INIT, i adr. of co-routine entry in LIBSINITIALIZE 
CLT_CO_ROuT) ! Adr. of CLI co=routine 


= ! Value returned is main program completion code 


ae 
FUNCTIONAL DESCRIPTION: 


It establishes a ERRTST/ERRSET default handler. 

Next, it calls FORSSINIT_ERRSET, a routine in the shared 

RTL, to give it the address of RECORD ERROR. This will be called 
whenever an 1/0 error occurs that is Erapped by error handling 

so that we know about all errors, not yver the untrenped ones. 
Then it performs a co-routine call-back to LIBSINITIALIZE 

which keeps the handler on the stack before the main program. 


FORMAL PARAMETERS: 
co_rout_init Adr. of a procedure to be called in order 


pele lojejlojlolelelelelelelelelelelolelolololo) 


PUPVFOPUPUPUSUSUSUSUSISUS ISIS ISIS 
DUP SVS Be BS BS BB EE EWAN 


to affect a co-routine Linkage with the 
: caller (LIBSINITIALIZE). 
cli_co_rout Adr. of CLI co-routine 
- Any other arguments passed to main programs 
NONE 
IMPLICIT OUTPUTS: | 
NONE 


| 
ROUTINE VALUE: | 
COMPLETION CODES: | 
| 
| 
| 


The completion code returned by the main program 
SIDE EFFECTS: 


' 
i 
i 
i 
i 
i 
i 
i 
i 
i 
i 
i 
i 
i 
i 
i 
i 
i 
i 
} IMPLICIT INPUTS: 
i 
i 
i 
i 
i 
i 
i 
i 
i 
i 
' 
i 
i 
Sets up a handter and does a co-routine call-back using co_rout_init. 


BEGIN 
ENABLE . : 
COM_HANDLER; ! Establish language independent handler 


'¢ 

' Call FORSSINIT_ERRSET and peas it the address of RECORD_ERROR. The 

! shared RTL will call RECORD ERROR whenever it finds an I/O error that 
' is to be unwound, so that if never gets to our handler. Therefore, 
our table always knows which errors have occurred. 


FORSSINIT_ERRSET (RECORD_ERROR); 


'¢ 
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Perform co-routine call-back to caller (LIBSINITIALIZE) 

which will call any other Library and user initialization procedures 
and then call the main program. 

When the main program return, return its completion status to caller 
which will get back to debugger or CLI. 


RETURN (.CO_ROUT_INIT) (); 
END; 


x 4,8) 


Oo 


MoImonwnviviviw = 
CONOULSWINO 


WANs 
foleleleleleleleolo) 
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COOONAOULS wr 
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End of COM_STARTUP routine 


-TITLE COMSSERRSET_TST FORTRAN compatibility error set 
and test 
IDENT \1-024\ 
-PSECT _F4PCOMPATSDATA,NOEXE, PIC,2 
0000000F 00000 eatatemees Yee, 
4F 00 00004 COMSSERR_TAB:: 
BYTE 


uw 
s 


* 0, 79 ; 
00# 00006 “BYTE of15] F 
4F GF GF GF GF 4F GF GF GF GF GF 4F 4F 00015 BYTE 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, - s 
oe¢e¢eeee¢#eegde#eeé@ @ee 000¢4 9, 79, 79, 79, 79, 79, 279, 79, 79. 799, = : 
4F 6D OO 4F GF 4F GF 4F GF GF GF GF GF GF 00033 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, = Z 
00 2B 2B 2B 2B 2B 00 6F 4F 4F O00 6F 69 4F 00042 79; 79; 79° 79° 79° 79° 79° 79° 79° 79° = : 
28 2B 2B 00 00 28 28 28 0B 0B 00 2B 00051 79, 0,109. 79. 111, 79, 165, 111,°0, 79, -: 
79, 111, 0, 43, 43, 43, 43, 43, 0. 48, =< ; 
43, 0, 6. it. 1, os, &. &. 6, 6, | : 
00# 000SE BYTE of$3 : 
2B 00061 "BYTE 4 : 
.PSECT LIBSINITIALIZE,NOWRT,NOEXE, GBL,2 
00000000" 00000 P.AAA: .ADDRESS COM_STARTUP : 
VECT= P. AAA 
.EXTRN FORSSERRSNS_SAV 
SEXTRN FORSSINIT ERRSET 
-EXTRN LIBSFIXUP_FLT LIBSSIM_TRAP 
“EXTRN LIBSINITIALIZE 


-PSECT _F4PCOMPATSCODE,NOWRT, SHR, PIC,2 
0000 00000 COM_STARTUP: 


«WORD Save nothing ; 053 
6D 0011 CF DE 0000 MOVAL 1$, (FP) : 057 
0000v CF 9F 0000 PUSHAB RECORD ERROR : 058 
000000006 00 oi FB 9008 CALLS #1, FORSSINIT_ERRSET ; 
04 BC 0 FB Oo12 CALLS #0, aCO_ROUT_INIT : 059 
0000 Baie 1$: «WORD Save nothing ; 057 
7E D4 6 19 CLRL = = (SP) ; 
5E DD 018 PUSHL SP F 
7E 04 AC D 0001D MOVO 4 (AP), =(SP) ; 
0000v CF 03 FB 00021 CALLS #3, COM_HANDLER : 


_— 


COREPEARSET 1ST FORTRAN compatibility error set and test 


i 


04 00026 


se 
=ten- 


; Routine Size: 39 bytes, Routine Base: _F4PCOMPATSCODE + 0000 


1980 93:31:32 


RET 


PBRRTL SRE CONSE TSy 64551 
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; 360 0601 1 ROUTINE COM_HANDLER ( ' FORTRAN gompat ibility default error handler 
$ 1 0602 1 S1G_ARGS_ADR ! Adr. of signal arg List 

; 6¢ 603 1 MCH-ARGS_ADRS i Adr. of mechanism arg List 

; 604 1 = ! Value is that of a condition handler 
> 364 605 1 

; 365 O08 1 ++ 

; 366 0607 1 ! FUNCTIONAL DESCRIPTION: 

3 Jer 0608 1! 

: 368 0609 1! COM_HANDLER performs default error handlin 

: 369 0610 1! which creates an environment compatible with the PDP-11 

; ae 0611 1! FORTRAN IV-PLUS error environment. 

; (371 pole ,? This environment is only created if the user has a: | 

: f oF : The actions taken depends on the conditon code being signaled: 

; 374 0615 1! SS$_UNWIND Just return and keep unwinding. 

: 375 0616 1! SS$_SSFAIL Return SS$_CONTINUE so 0.S. caller 

3 Se 0617 1! can check error status at call site. 

re 0618 1! S$S$_ROPRAND Fixup floating/double operand by cp} Ling LIBSFIXUP_FLT. 

; 378 0619 1! SSS_FLTOVF_F...SS$_FLTUND_F Convert to trap by calling LIBSSIM_TRAP. 

; 379 0620 1! SSS_INTOVF...SSS$_SOBRNG Convert to FORTRAN error number from 

; $00 Bos) : arithemtic trap condition value. 

; 38 0698 2. If a math error which returns a reserved operand, change it to +0.0 and continue 
; 38 0626 1! execution with no message printed. 

> 384 0625 1! If not a FOR$ error, save error info for ERRSNS 

; 385 pose . 7 (If a FORS error, FORSSERRSNS_SAV eiready called when signaled). 

; 386 0627 1! Determine FORTRAN error number from condition value. PS 

5; ier 0628 1! Use 1 (NOT FORTRAN SPECIFIC ERROR) if not a FORTRAN specific error. 

: 388 +434 1} Flag that error number has had an occurrence (for ERRTST) ; ; 
; 389 0630 1! f error can never continue or ERR=, set severity to SEVERE and resignal (which EXITs). 
; 390 0631 1! If error is ERR= type, set severity to SEVERE and resignal (which EXITSs), 

; ott 1! since ERR= transfer would already have taken place if present. 

; 392 0633 1! If error wants to be counted, decrement image error count. _ 

; 393 0634 1! If exceed Limit, set severity to SEVERE and resignal (which EXITs). 

: 394 0635 1! If error is to continue, set severity to ERROR, else to SEVERE. 

3 0636 1! If error is to be logged, resignal else continue. 

3; 3 0637 1! 

s wer U638 1 ! FORMAL PARAMETERS: 

; $05 0639 1! : ; 

3 0640 1! SIG_ARGS_ADR.ml.ra Adr. of signal arg list. 

; 4 0641 1! MCH_ARGS_ADR.ml.ra Adr. of mechanism arg List 

; 401 0642 1! 

: 40 0645 1 ! IMPLICIT INPUTS: 

; 40 0644 1! 

3; 404 0645 1! NONE 

; 405 0646 1! 

; 0647 1 ! IMPLICIT OUTPUTS: 

; 407 0648 1! ; ibe 

3 rs 4 4 } : Decrements OWN count of no. of continuable error remaining before EXIT (ERROR_LIMIT). 
; 410 651 1 ! ROUTINE VALUE: 

: ot) O2¢ : } COMPLETION CODES: 

; 418 oes 1! SS$_CONTINUE if signaled code was SS$_SSFAIL or error is to be continued without logging. 
3 414 0655 1! SS$_RESIGNAL otherwise. 

3 «415 0656 1! 

; 6416 0657 1 ! SIDE EFFECTS: 


mam 


d 3 
16-Sep-1984 00:11:31 AX-11 BLi 
10288b-198¢ 9:51:84 FORRTL.SR 


' 
: Signaled condition value is changed to ERROR or SEVERE — 
in order to cause image to continue or EXIT after printing message. 


ow 
un 
ot 
Ow 


BEGIN 


LOCAL 
FORT_ERR_NO; ! FORTRAN error number 


MAP 
G_ARGS_AD® : REF BLOCK FB. BYTE), ! SIGNAL arg List 
H_ARGS_ADR : REF BLOCK (5, BYTE); ! mechanism arg List 


t+ 


i Check for unwinding since handler gets called when it does an unwind. 
Just return to continue unwinding, since nothing to do. 


WN “CO DONAUSWN OOO 
oO 
oa 
o 
Oo 


IF .SIG_LARGS_ADR CCHFSL_SIG_NAME] EQL SS$_UNWIND THEN RETURN SS$_NORMAL; 


'¢ 

! Check if this is a system service failure exception (i.e., SSFAIL mode 

! set oh veer in violation of ageuter sty stendecys). If yes just return 
i 


02 
4 
4 
4 
4 
4 
4 
4 
4 
4 
4 
4 
4 
4 
4 
4 
4 
4 
4 
4 
4 
4 


438 0679 
4 


441 068 ! SS$_CONTINUE status to condition handling facility which will return to the 
a28 peez OTS call-site to operating system which will check error code returned in RO. 
4 0685 ; 

445 0686 IF .SIG_ARGS_ADR CCHFSL_SIG_NAME] EQL SS$_SSFAIL THEN RETURN SS$_CONTINUE; 
447 0688 '¢ 

448 0689 ! If signal is SS$_ROPRAND (reserved operand fault), 

449 0690 ! 9° fixup if tloating point by setting operand to +0.0. 

450 0691 ' Then continue execution without a meseaye Do not convert this error 

$23 298 to a FORTRAN error # since this error didn't happen on the PDP-11. 

453 0694 : 

436 0695 IF LIBSFIXUP_FLT (.SIG_ARGS_ADR, .MCH_ARGS_ADR) THEN RETURN SS$_CONTINUE; 

456 0697 '¢ 

457 0698 ! If this is a floating fault, convert it to a rue by calling 

458 0699 ' LIBSSIM_TRAP. LIBSSIM_TRAP will return SS$_RESIGNAL if this is 

459 0700 ' not a floating fault, @lse it will simulate a trap and “‘resignal"’. 

460 0701 ! If this paopens control will never return here. The return 

4 of SS$_CONTINUE is just to keep BLISS happy - it will never execute. 


ooceo 


RUNW—OSR NAR 


IF LIBSSIM_TRAP (.SIG_ARGS_ADR, .MCH_ARGS_ADR) THEN RETURN SS$_CONTINUE; 


i¢ 

! If this is a math Library error which is about to return a reserved operand, 
! convert RO/R1 to +0.0 in mechanism arg List so user program 

: will get the same function value as on the PDP-11. 


IF _.STS_FAC_NO EQL MTHSK_FAC_NO 
THEN 


Ba Be Oe Oe Oe Oe Be Be Oe FH Oe Oe Be Be Oe Se FH Se Oe BH ee Oe Be Oe BH Oe oe BH Oe ws Oe Oe Oe OHS Oe OHO Oe Oe HOH Ose Oe OHS SHS Se Se Seer ee See 

= 

Ps 

o 

oO 

o 

oo 

™~ 
PRIPIPIPIPGPININININPINDNINDPYNININYNYININPYPINYININPININININININININININPINIPYININIPINIPIPUPIPINIPUNPIPININYNPY 2 SS SS 
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: 476 715 
> 475 rig CASE .STS_CODE FROM MTHSK_UNDEXP TO MTHSK_FLOOVEMAT OF 
oh Bi na 
3 38 1884 Os ee MTHSK_LOGZERNEG, MTHSK_SQUROONEG, MTHSK_SIGLOSMAT, MTHSK_FLOOVEMAT) : 
; 480 721 MCH_ARGS_ADR ECHFSL_MCH_SAVRO = 0; 
> 481 7 ¢ MCH_ARGS_ADR CCHFSL_MCH_SAVR1) = G; 
: 48 7 END; 
; 48 0724 
; tke 4 2 CINRANGE) : ra re 
; : ! do nothin 
: 486 8759 , 
; 487 0728 COUTRANGE) : ! do nothing 
> 4488 0729 TES; 
> 489 0730 
: 490 0731 1+ : ; 
> 491 07 ¢ ! If this is an arithmetic trap error, map to FORTRAN error number. 
; 49 07 : Condition values are: _INTOVF, _INTDIV, _FLTOVF, _FLTDIV, _FLTUND, _DEVOFV, _SUBRNG. 
; 49 0734 ! and are assumed to be Consectutive and in ascending order according 
> 4946 0735 2 ! to hardware trap number. Trap codes 1:5 map to error 70:74 
; 495 0736 § ' and trap code 7 maps to error 77. Other codes map to error 1. 
> 496 0737 !- 
; 497 0738 2 
; 498 0739 2 IF .STS_COND_ID GEQU SS$_INTOVF*=-S_SEVERITY AND .STS_COND_ID LEQU SS$_SUBRNG“*-S_SEVERITY 
; 499 0740 THEN 
; 500 0741 BEGIN 
; 501 Bree 
3 Fee 0743 3 BIND 
; 503 0744 H TRAN = UPLIT BYTE(70, 71, 72, 73. 74, 1, 77); 
> 504 0745 
; 0746 3 P 
; 506 0747 3 TRAN : VECTOR (7, BYTE]; 
; 507 0748 3 
; 508 0749 3 FORT_ERR_NO = .TRAN [.STS_COND_ID - (SS$_INTOVF*=S_SEVERITY)]; 
3 307 0750 END 
; 510 0751 2 ELSE 
g 33% ES 2 
: 21§ 0753 2 '¢ 
3 3 0754 2 ! Setup FORTRAN error number and check range for index into error tat'e. 
; a8 Bree 2 : If out of range, map to error 1 (NOT FORTRAN SPECIFIC ERROR) 
; 516 0757 
s 6 Si7 0758 FORT_ERR_NO = (SELECTONEU .STS_FAC_NO OF 
; 518 0759 SET 
: 519 0760 CFORSK_FAC_NO) : .STS_CODE; ! FORS errors 
s Seo 0761 freee FAC_NO) : .STS CODE; ! MTHS errors 
; Sel O768 ; OTHERQISET : FORSK_NOTFORSPE; ' other, use error code 1 
; 256 076 ! NOT FORTRAN SPECIFIC ERROR 
:. he 0764 TES); 
; 524 0765 
3. Seo 0766 + : : 
, See 0767 ! If error table has no bits set for this error, also map to 1 
g Ser 0768 ! since error is not defined. 
oe Bee 
3 286 0771 IF .COMSSERR_TAB C.FORT_ERR_NO, B_EC_ANY] EQL 0 THEN FORT_ERR_NO = FORSK_NOTFORSPE; 
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14 
' Save error info for ERRSNS if t error is not FOR$ error. 


his 
} (FOR$S errors already called FORSSERRSNS_SAV when error was signaled). 


IF STS_FAC_NO NEQ FORSK_FAC_NO 


; or7e 

3 655 

; 774 

; 0775 

; 0776 

3 0777 

: 338 $999 

: 539 0780 FORSSERRSNS_SAV (.FORT_ERR_NO, 0, 0, 0, 

; 540 0781 ~SIG_ARGS_ADR CCHFSL_SIG_NAME]): 

abe: alee 

: 508 Orb Flag that this FORTRAN error number happened for subsequent CALL ERRTST 
: 545 0786 

; 546 0787 COMSSERR_TAB C.FORT_ERR_NO, V_EC_OCCURRED) = 1; 

ae Ns 

: 549 0790 § i If this error can never continue (or ERR=) or continue type 

; 550 0791 : is ERR= (if present in 1/0 statement), set severity to SEVERE and resignal. 
; «6551 O78 2 ' Note: if continue type is ERR=, user did not supply if control 

; 226 tad, § ; gets here to defualt condition handler setup before main program called. 
: 554 0795 ; 

; 555 0796 é IF NOT .COMSSERR_TAB C.FORT_ERR_NO, V_EC_CONTINUE] OR .COMSSERR_TAB [C.FORT_ERR_NO, V_EC_CONT_TYPE] 
eo RL em 

; 238 o799 § IF STS_FACLNO EQL FORSKFAC_NO 

: 60 0801 3 STS_SEVERITY = STSSK_SEVERE; 

; 5o) 0802 3 RETURN $S$_RESIGNAL 

s See 080 END; 

epee 

; 565 0806 i If this error wants to be counted, decrement image error count Limit. 
: 36 oan 5 

: 568 0809 3 IF .COMSSERR_TAB C.FORT_ERR_NO, V_EC_COUNT] 

fm Get Mh 

: 571 B12 COMSSERRORCOUNT = .COMSSERRORCOUNT - 1; 

ee Be . 

; 574 Baie i If error Limit goes to 0, set error severity Fo 

3 ite 0 19 ' to SEVERE and resignal so that image exits after printing message. 
me Rt : 

: 578 0819 IF .COMSSERRORCOUNT LEQ 0 

ie Bi 

: 581 OB ‘ 4 STS SEVERITY = STSS$K_SEVERE; 

3 28¢ 08 4 RETORN SS$_RESIGNAL 

s 38 824 ; END; 

; 584 825 

3 2 4 § : END; 

; 359 0828 '¢ 
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1-026 1er8ebi13be $3:31:3, EPG anre SReicomse 189.0495 1 ea | 
; oB8 ge 9 ! If here, error is to continue (V_EC_CONTINUE = 0) ; 
3 34 oS ? set severity to ERROR so continue if resignaled (ie if logged). : 
: 591 8 : 
; 08 : STS_SEVERITY = STSS$K_ERROR; : 
; 2 0834 $ 
; 236 8B 3 ine thi i be | 6, t it b i li d i 
; : s error is to be logged, log it resignaling and continue image. : 
; 4 083? : Otherwise just continue lesee (without Fes tonsl ine So no message). ° : 
; $98 0839 : 
; 399 0840 IF .COMSSERR_TAB [.FORT_ERR_NO, V_EC_LOG] THEN RETURN SS$_RESIGNAL ELSE RETURN SS$_CONTINUE ; 
; 601 0842 1 END; ! End of COM_HANDLER ; 
4D 01 4A 49 48 47 46 00027 P.AAB: .BYTE TOs Fla Vea the fee te tT : : 
TRAN= P.AAB ; 
003C 00000 COM_HANDLER: ; 
WORD Save R2,R3,R4,R5 ; 0601 : 
55 00000000" EF 9€ 00002 MOVAB COMSSERR_TAB, R5 3 ; 
53 04 AC 00 00009 MOVL SIG_ARGS_ADR, R3 3; 0677 : 
54 04 A3 9E 00000 MOVAB 4(R3), R : 3 
00000920 = &F 64 01 00011 CMPL (R4), #2336 3 $ 
07 13 00018 BEQL 1$ 3 3 
0000045C 8F 64 D1 QOO1A CMPL (R4), #1116 ; 0686. : 
03 12 00021 1$: BNEQ 3$ : 3 
OODF 31 00023 +f BRwW 18$ : 3 
52 08 AC DO 00026 3$: MOVL MCH_ARGS_ADR, R2 ; 0695. : 
26 DD 0002A PUSHL R2 PF Hy 
53 DD 000eC PUSHL R3 : | ; 
000000006 00 02 FB QO02E CALLS #2, LIBSFIXUP_FLT 3 : 
EB 50 €8 00035 BLBS RO, 2$ : 3 
26 DD 00038 PUSHL Re ; 0705, ; 
53 DD O003A PUSHL R3 3 : 
00000000G 00 02 FB 0003C CALLS #2, LIBSSIM_TRAP 3 : 
DD 50 €8 00043 BLBS RO, 3 : 
16 02 AG 0c 00 ED 00046 CMPZV #0, #12, 2(R4), #22 3 0713. ; 
20 12 0004C NEQ 6$ : : 
50 64 g 9 EF 4d EXTZ7V #3, Ate (R4), RO ; 0716. : 
06 00000052 7 0 CF 0005 CASEL RO, #82, #6 : : 
0013 0010 0010 por p008 4$: «WORD 5$-4$,- : ’ 
0010 0010 001 0006 5$-4$,- j : 
5$-4$,- 3 3 
6$-4$,- 3 3 
6$-4$,- : 3 
5$-4$,- : F 
03 11 00069 ae ee 
Oc Ae 7C So088 5$: CLRQ Ng (R2) : O78 3 
8F 64 19 03 ED BO 8gs 6$: CMPZ2V #5, #25, (RO), #143 ; 0759 : 
18 1F 0007 BLSSU 7$ ; 3 

8F 64 19 03 ED 00079 CMPZV «#3, #25, (R4), #149 : 
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COMSSERRSET_TST 4 Shang wee error set and test 16-Sep-1984 OO 41:3) AX-11 Bliss-32 V4.0-74 
1-024 RECORD 14-Sep-1984 12:31:34 FORRTL.SRCICOMSETST.B32;1 
: 603 0843 1 ZSBTTL'RECORD ERROR' 
; 604 0844 1 ROUTINE RECORBD_ERROR ( 
; 605 0845 1 eg UMBER 
; ¢ rk 1 ): NOVAL UE = 
; 60 0847 1 
; 608 9k 1 44 
: o08 +e : FUNCTIONAL DESCRIPTION: 
: 611 0851 1: This routine is called by FORSSERRSNS_SAV in the shared RTL to 
5 ole pe2g 1! record that an 1/0 error occurred. Because an error can get 
; 61 08535 1! trapped by ERR=, END= or IOSTAT=, COM HANDLER doesn't see all 
> 614 pee 1 errors. This mechanism ensures that ERRTST will always know 
: 615 855 i | that an error occurred. that COM_STARTUP passes the address 
3 o1g bees : : of this routine to FORSSINIT. *ERRSET, which stores it for later use. 
: 618 0858 1 i FORMAL PARAMETERS: 
; 619 0859 1: 
; 620 0860 1! ERROR_NUMBER - The FORTRAN error number of the error that 
; O21 0861 1! occurred. 
; ose Baee a 
3 62 086 1 ' IMPLICIT INPUTS: 
; 624 0864 1! 
; 625 0865 1} NONE 
> 626 0866 1} 
: 627 9867 1°! IMPLICIT OUTPUTS: 
; 628 0868 1! 
; 629 0869 1! COMSSERR_TAB 
: 630 0870 1! 
: 631 0871 1 ! ROUTINE VALUE: 
: 632 fh 1: 
3 633 0873 1: NONE 
: 634 0874 1: 
; 635 0875 1 | SIDE EFFECTS: 
; 636 0876 1! 
3; 637 0877 1: NONE 
: 638 0878 1 I- 
; 639 0879 1 
: 640 0880 3 BEGIN 
; 641 0881 
: 64 ttt § + 
5 “7 st - Flag that this FORTRAN error number happened for subsequent CALL ERRTST 
3: 645 0885 
: 646 0886 COMSS$ERR_TAB C.ERROR_NUMBER, V_EC_OCCURRED) = 
: 647 088 
3; 648 0888 § RETURN; 
3; 649 0889 
; 650 0890 1 END; ! End of RECORD_ERROR 
0000 00000 RECORD_ERROR: 
50 00000090" EF 0002 HOVAB COMSSERR TAB, RO 
04 BC40 Br 0009 BI SBo #128, @ERROR- *NUMBEREROJ 


: 0844. 


; 0886, 
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1-024 RECORD_ERRO 14-Sep-1984 12:31:34 FORRTL.SRCIC COMSET S$T.832;1 (5) 


04 0000F RET ; 0890 
; Routine Size: 16 bytes, Routine Base: _F4PCOMPATSCODE + 0137 


: END ! End of module 
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PSECT SUMMARY 


Name Bytes Attributes 
| 
graye dt 4 moves NOWRT, RD ,NOEXE,NOSHR, GBL, REL, CON,NOPIC,ALIGN(2) 
_F4PCOMPATSDATA 98 NOVEC, WRT, RD ,NOEXE,NOSHR, LCL, REL, CON, PIC,ALIGN(2) 
-F CPCOMPATSCODE 327 NOVEC. -NOWRT, RD, EXE, SHR, LCL, REL, CON, PIC,ALIGN(2) 


Library Statistics 


peeeprimeaes Syabols o<eosee Pages Processing 
File Total idaded Percent Mapped Time 
~$255$DUA28: CSYSLIBISTARLET.L32;1 9776 16 0 581 00:01.0 


COMMAND QUALIFIERS | 
BLISS/CHECK=(FIELD, INITIAL, OPTIMIZE) /NOTRACE/LIS=LIS$:COMSETST/OBJ=OBJ$:COMSETST MSRC$:COMSETST/UPDATE=(ENH$: COMSETST) 
Size: 320 code 5 + 109 data bytes 


; Elapsed tine: 0:44, H 
; Lines/CPU Min: 3543 

; Lexemes/CPU-Min: 28222 

; penery Used: 117 pages 

; Compilation Complete 
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